home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / NUMBERS.SWG / 0056_NUM2WORD.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-26  |  5KB  |  225 lines

  1. Unit Num2Word;
  2. {* Program by: Richard Weber - 08/02/94 - 4 hours work *}
  3. {* 70614,2411 *}
  4. Interface
  5.  
  6. {* BY: Richard Weber                                                     *}
  7. {* CrazyWare  -  08/02/94                                                *}
  8. {* CompuServe ID: 70614,2411                                             *}
  9.  
  10. {* This program was written in 4 hours.                                  *}
  11.  
  12. {* Program is self Explainatory.  There is only one available function.  *}
  13. {* Function Number2Name(L : LongInt) : String;                           *}
  14.  
  15. {*    If you call Number2Name(20) it will return the word equalivent     *}
  16. {*    as a string.  It function will process up to 2 billion and will    *}
  17. {*    not process numbers less than zero or fractions of one.            *}
  18.  
  19. {* I hope the unit comes in handy and will prevent you from working      *}
  20. {* one out form scratch.                                                 *}
  21.  
  22. {* Feel free to modify and expand it as will.  Please leave me a message *}
  23. {* for any questions or comments.                                        *}
  24.  
  25.  
  26.   Function Number2Name(L : LongInt) : String;
  27.   { Function converts Long Integer supplied to a Word String }
  28.  
  29. Implementation
  30.  
  31. CONST
  32.   N_Ones : Array[0..9] of String[5] =
  33.     ('',
  34.      'One',
  35.      'Two'  ,
  36.      'Three',
  37.      'Four',
  38.      'Five',
  39.      'Six',
  40.      'Seven',
  41.      'Eight',
  42.      'Nine');
  43.   N_OnesX : Array[0..9] of String[9] =
  44.     ('Ten',
  45.      'Eleven',
  46.      'Twelve',
  47.      'Thirteen',
  48.      'Fourteen',
  49.      'Fifteen',
  50.      'Sixteen',
  51.      'Seventeen',
  52.      'Eightteen',
  53.      'Nineteen');
  54.   N_Tens : Array[2..10] of String[7] =
  55.     ('Twenty',
  56.      'Thirty',
  57.      'Forty',
  58.      'Fifty',
  59.      'Sixty',
  60.      'Seventy',
  61.      'Eighty',
  62.      'Ninety',
  63.      'Hundred');
  64.   N_Extra : Array[1..3] of String[8] =
  65.      ('Thousand',
  66.      'Million',
  67.      'Billion');
  68.  
  69.   Hundred = 10;  {* N_Tens[10] *}
  70.  
  71.   Function LongVal(S : String) : LongInt;
  72.   Var
  73.     TmpVal : LongInt;
  74.     Count  : Integer;
  75.     Begin
  76.       Val(S, TmpVal, Count);
  77.       LongVal := TmpVal;
  78.     End;
  79.  
  80.   Function Long2Str(L : LongInt) : String;
  81.   Var
  82.     S : String;
  83.   Begin
  84.     Str(L,S);
  85.     Long2Str := S;
  86.   End;
  87.  
  88.   Function Number2Name(L : LongInt) : String;
  89.   Var
  90.     NameString   : String;
  91.     NumberString : String;
  92.     Finished     : Boolean;
  93.     Place        : Integer;
  94.     StopPlace    : Integer;
  95.     BeginPlace   : Integer;
  96.     CountPlace   : Integer;
  97.  
  98.   Function Denom(I : Integer) : String;
  99.   Var
  100.     TestPlace : Integer;
  101.  
  102.     Begin
  103.      TestPlace := I Div 3;
  104.      If I Mod 3 <> 0 then Inc(TestPlace);
  105.  
  106.      If TestPlace > 1 then
  107.        Denom := N_Extra[TestPlace-1]
  108.       Else
  109.        Denom := '';
  110.     End;
  111.  
  112.   Function TensConvert(S : String) : String;
  113.   Var TmpStr : String;
  114.    Begin
  115.      If Length(S) > 2 then S := Copy(S,2,2);
  116.      TensConvert := '';
  117.  
  118.      If LongVal(S) <= 19 then
  119.        Begin
  120.          If LongVal(S) >=10 then
  121.            TensConvert := N_OnesX[LongVal(S)-10]
  122.           Else
  123.            TensConvert := N_Ones[LongVal(S)];
  124.        End
  125.       Else
  126.        Begin
  127.          TmpStr := N_Tens[LongVal(S) Div 10];
  128.          If LongVal(S) Mod 10 <> 0 then
  129.            TmpStr := TmpStr + '-' + N_Ones[LongVal(S) Mod 10];
  130.          TensConvert := TmpStr;
  131.        End;
  132.    End;
  133.  
  134.   Function HundredConvert(S : String; Place : BYTE) : String;
  135.   Var
  136.     TmpString  : String;
  137.  
  138.     Begin
  139.     TmpString := '';
  140.     If LongVal(S) > 0 then
  141.       Begin
  142.  
  143.       If (Length(S) = 3) and (LongVal(S[1]) > 0) then
  144.             TmpString := TmpString + ' ' + N_Ones[LongVal(S[1])]+
  145.             ' ' + N_Tens[Hundred];
  146.  
  147.         TmpString := TmpString + ' ' + TensConvert(S);
  148.  
  149.         TmpString := TmpString + ' ' + Denom(Place);
  150.  
  151.       End;
  152.       HundredConvert := TmpString;
  153.     End;
  154.  
  155.   Begin
  156.    If L > 0 then 
  157.    Begin
  158.     StopPlace := 0;
  159.     Place := 3;
  160.     NameString   := '';
  161.     NumberString := Long2Str(L);
  162.  
  163.     Finished := False;
  164.     Repeat
  165.       If Place > Length(NumberString) then
  166.        Begin
  167.         Place := Length(NumberString);
  168.         Finished := True;
  169.        End;
  170.  
  171.       IF Place <> StopPlace then
  172.        Begin
  173.         BeginPlace := Length(NumberString)-Place+1;
  174.         CountPlace := Place-StopPlace;
  175.         NameString := HundredConvert(Copy(NumberString,BeginPlace,CountPlace),Place ) + NameString;
  176.        End;
  177.  
  178.       StopPlace := Place;
  179.       Inc(Place,3);
  180.     Until Finished;
  181.  
  182.     Number2Name := NameString;
  183.    End
  184.    Else
  185.     Number2Name := ' Zero';
  186.  End;
  187.  
  188. Begin
  189. End.
  190.  
  191. { ---------------   demo ------------------------- }
  192.  
  193. Program TestNum;
  194. Uses Num2Word;
  195.  
  196. Var
  197.  Lop : Integer;
  198.  Tmp : LongInt;
  199.  
  200. Begin
  201.  Writeln;
  202.  Randomize;
  203.  For Lop := 1 to 10 do
  204.   Begin
  205.     Tmp := Random(65534);
  206.     Writeln(Tmp, Number2Name(Tmp));
  207.   End;
  208.  
  209.  Readln;
  210.  
  211.  
  212.  For Lop := 0 to 20 do
  213.   Begin
  214.     Writeln(Lop, Number2Name(Lop));
  215.   End;
  216.  
  217.  Readln;
  218.  
  219.  
  220.  For Lop := 10 to 100 do
  221.   Begin
  222.     Writeln(Lop*10, Number2Name(Lop*10));
  223.   End;
  224.  
  225. End.